00100	
00200	
00300	(DEFPROP NAME 
00400	 (NIL NAME >PREDLET< BUILTED BUILTCH BUILTED1 BUILTCH1 SETSUP) 
00500	VALUE)
00600	
00700	(DEFPROP >PREDLET< 
00800	 (LAMBDA(X)
00900	  (OUTRUL X (FUNCTION (LAMBDA NIL (COND ((MEMQ (STK1) (APPEND INFPREDLET PREPREDLET)) (STK1)) (*NIL*)))))) 
01000	EXPR)
01100	
01200	(DEFPROP BUILTED 
01300	 (LAMBDA (X) (LIST (QUOTE LAMBDA) (QUOTE (C)) (BUILTED1 X))) 
01400	EXPR)
01500	
01600	(DEFPROP BUILTCH 
01700	 (LAMBDA(X)
01800	  (PROG (Z)
01900		(SETQ Z (BUILTCH1 X))
02000		(RETURN
02100		 (COND ((OR (ATOM Z) (EQUAL Z (QUOTE (AND))) (EQUAL X (QUOTE (OR)))) NIL)
02200		       (T (LIST (QUOTE LAMBDA) (QUOTE (C1 C2)) Z)))))) 
02300	EXPR)
02400	
02500	(DEFPROP BUILTED1 
02600	 (LAMBDA(X)
02700	  (COND ((ATOM X) X)
02800		((ATOM (CAR X)) (CONS (CAR X) (BUILTED1 (CDR X))))
02900		((EQ (CAAR X) (QUOTE DEMOD)) (SETQ DDEPTH (CADDR X)) (SETQ DLIST (*CL (CADR X))) (BUILTED1 (CDR X)))
03000		(T (CONS (BUILTED1 (CAR X)) (BUILTED1 (CDR X)))))) 
03100	EXPR)
03200	
03300	(DEFPROP BUILTCH1 
03400	 (LAMBDA(X)
03500	  (COND ((ATOM X)
03600		 (COND ((EQ X (QUOTE ANCESTRY)) (SETQ ANCESTRY T) NIL)
03700		       ((EQ X (QUOTE NONE)) NIL)
03800		       ((MEMQ X (QUOTE (VINE ALLPOS ALLNEG UNIT)))
03900			(LIST (QUOTE OR) (LIST X (QUOTE C1)) (LIST X (QUOTE C2))))
04000		       (T X)))
04100		((EQ (CAR X) (QUOTE SUPPORT)) (SETSUP (CDR X)) (QUOTE (SUPPORT C2)))
04200		((EQ (CAR X) (QUOTE MODEL)) (SETQ PMODEL (CADR X))
04300					    (SETQ NMODEL (CADDR X))
04400					    (QUOTE (OR (NOT (MODEL C1)) (NOT (MODEL C2)))))
04500		((EQ (CAR X) (QUOTE DEFMODEL))
04600		 (LIST (QUOTE OR)
04700		       (LIST (QUOTE NOT) (LIST (CDR X) (QUOTE C1)))
04800		       (LIST (QUOTE NOT) (LIST (CDR X) (QUOTE C2)))))
04900		((EQ (CAR X) (QUOTE ANCESTRY)) (SETQ ANCESTRY T) (BUILTCH1 (CDR X)))
05000		((ATOM (CAR X)) (CONS (CAR X) (BUILTCH1 (CDR X))))
05100		((EQ (CAAR X) (QUOTE EQUALITY)) (SETQ PFLG NIL)
05200						(SETQ EQUAL (CADAR X))
05300						(SETQ PDEPTH (CADDAR X))
05400						(BUILTCH1 (CDR X)))
05500		(T (CONS (BUILTCH1 (CAR X)) (BUILTCH1 (CDR X)))))) 
05600	EXPR)
05700	
05800	(DEFPROP SETSUP 
05900	 (LAMBDA(X)
06000	  (PROG (Z)(SETQ X(*CL X))
06100	   A    (COND ((NULL X) (SETQ SUPPORT Z) (RETURN NIL)))
06300		(SETQ Z (CONS (CDAR X) Z))
06400		(SETQ X (CDR X))
06500		(GO A))) 
06600	EXPR)